COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002
C00005 ENDMK
C⊗;


(DEFPROP COMPILE 
 (LAMBDA(FN VARS EXP)
  (PROG (N)
	(SETQ N (LENGTH VARS))
	(RETURN
	 (APPEND (LIST (LIST (QUOTE LAP) FN (QUOTE SUBR)))
		 (COMPEXP EXP (MINUS N) (PRUP VARS 1))
		 (LIST (LIST (QUOTE POP) (QUOTE P) (MINUS (ADD1 N)) (QUOTE P)))
		 (LIST (LIST (QUOTE POP) (QUOTE P) (MINUS (SUB1 N)) (QUOTE P)))
		 (LIST (LIST (QUOTE SUB) (QUOTE P) (LIST (QUOTE C) 0 0 (DIFFERENCE N 2) (DIFFERENCE N 2))))
		 (QUOTE ((POPJ P 0))))))) 
EXPR)

(DEFPROP COMPEXP 
 (LAMBDA(EXP M VPL)
  (COND ((NULL EXP) (QUOTE ((PUSH P 0))))
	((OR (EQ EXP T) (NUMBERP EXP)) (LIST (LIST (QUOTE PUSH) (QUOTE P) EXP)))
	((ATOM EXP) (LIST (LIST (QUOTE PUSH) (QUOTE P) (PLUS (SUB1 M) (CDR (ASSOC EXP VPL))) (QUOTE P))))
	((EQ (CAR EXP) (QUOTE QUOTE)) (LIST (LIST (QUOTE PUSH) (QUOTE P) EXP)))
	(T (COMPAPPLY (CAR EXP) (COMPLIS (CDR EXP) M VPL) (LENGTH (CDR EXP)))))) 
EXPR)

(DEFPROP COMPLIS 
 (LAMBDA (U M VPL) (COND ((NULL U) NIL) (T (APPEND (COMPEXP (CAR U) M VPL) (COMPLIS (CDR U) (SUB1 M) VPL))))) 
EXPR)

(DEFPROP COMPAPPLY 
 (LAMBDA (FN ARGS N) (APPEND ARGS (LIST (LIST (QUOTE CALL) N (LIST (QUOTE E) FN))))) 
EXPR)

(DEFPROP PRUP 
 (LAMBDA (VARS N) (COND ((NULL VARS) NIL) (T (CONS (CONS (CAR VARS) N) (PRUP (CDR VARS) (ADD1 N)))))) 
EXPR)

(DEFPROP EXP 
 (NIL F (G X) (H Y)) 
VALUE)

(DEFPROP FN 
 (NIL . J) 
VALUE)

(DEFPROP VARS 
 (NIL X Y) 
VALUE)